Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue31/bcolorbt/BCOLORBT.ZIP/ColorAEd.pas

Pascal/Delphi Source File | 1998-01-08 | 8.6 KB | 314 lines

{$I DFS.INC}  { Standard defines for all Delphi Free Stuff components }

{-----------------------------------------------------------------------------}
{ A Windows 95 and NT 4 style color selection button.  It displays a palette  }
{ of 20 color for fast selction and a button to bring up the color dialog.    }
{ Copyright 1996, Brad Stowers.  All Rights Reserved.                         }
{ This component can be freely used and distributed in commercial and private }
{ environments, provied this notice is not modified in any way and there is   }
{ no charge for it other than nomial handling fees.  Contact me directly for  }
{ modifications to this agreement.                                            }
{-----------------------------------------------------------------------------}
{ Feel free to contact me if you have any questions, comments or suggestions  }
{ at [e-mail].                                                      }
{ The lateset version will always be available on the web at:                 }
{   http://www.pobox.com/~bstowers/delphi/                                    }
{-----------------------------------------------------------------------------}
{ Date last modified:  December 27, 1997                                      }
{-----------------------------------------------------------------------------}


{-----------------------------------------------------------------------------}
{ TColorArrayEditor                                                           }
{-----------------------------------------------------------------------------}
{ Description:                                                                }
{   This is a support unit for the TDFSColorButton component (COLORBTN.PAS).  }
{-----------------------------------------------------------------------------}
unit ColorAEd;

interface

uses
  WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, CBtnForm, DsgnIntf, StdCtrls;

type
  TColorArrayEditor = class(TForm)
    btnOK: TButton;
    btnCancel: TButton;
    ColorDlg: TColorDialog;
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormShow(Sender: TObject);
    procedure FormClick(Sender: TObject);
  private
    FColors: TColorArrayClass;
    FLastFrame: TPoint;
    procedure SetColors(Val: TColorArrayClass);
    procedure DrawSquare(X, Y: integer; AColor: TColor; IsFocused: boolean);
    procedure FrameCurrentSquare;
    function ValidColorIndex(X, Y: integer): boolean;
    function GetCurrentSquare: TPoint;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property Colors: TColorArrayClass
       read FColors
       write SetColors;
  end;

  TColorArrayProperty = class(TClassProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function AllEqual: boolean; override;
  end;

implementation

{$R *.DFM}


constructor TColorArrayEditor.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FColors := NIL;
end;

destructor TColorArrayEditor.Destroy;
begin
  FColors.Free;
  inherited Destroy;
end;

procedure TColorArrayEditor.SetColors(Val: TColorArrayClass);
begin
  if FColors = NIL then
    FColors := TColorArrayClass.Create(Val.XSize, Val.YSize);
  FColors.Assign(Val);
end;



procedure TColorArrayProperty.Edit;
var
  Dlg: TColorArrayEditor;
begin
  Application.CreateForm(TColorArrayEditor, Dlg);
  try
    Dlg.Caption := Self.GetName;
    Dlg.Colors := TColorArrayClass(GetOrdValue);
    if Dlg.ShowModal = mrOk then
    begin
      { SetOrdValue will operate on all selected propertiy values }
      SetOrdValue(Longint(Dlg.Colors));
      Modified;
    end;
  finally
    Dlg.Free;
  end;
end;

function TColorArrayProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paReadOnly, paMultiSelect];
end;

function TColorArrayProperty.AllEqual: boolean;
var
  SourceColors: TColorArrayClass;
  x: integer;
begin
  Result := FALSE;
  if PropCount > 1 then
  begin
    { Get first selected color set }
    SourceColors := TColorArrayClass(GetOrdValue);
    for x := 1 to PropCount-1 do
    begin
      { Compare first selected to all other selected color sets }
      if not SourceColors.IsEqualTo(TColorArrayClass(GetOrdValueAt(x))) then
        exit;
    end;
  end;
  Result := TRUE;
end;


procedure TColorArrayEditor.FormPaint(Sender: TObject);
var
  X, Y: integer;
begin
  for x := 1 to Colors.XSize do
  begin
    for y := 1 to Colors.YSize do
    begin
      { Draw color square }
      DrawSquare(X, Y, FColors[x,y], FALSE);
    end;
  end;

  { Draw the current selection }
  FrameCurrentSquare;

  { Draw seperator line }
  y := Colors.YSize * 18 + 14;
  with Canvas do
  begin
    Pen.Color := clBtnShadow;
    MoveTo(5, y);
    LineTo(ClientWidth - 5, y);
    Pen.Color := clBtnHighlight;
    inc(y);
    MoveTo(5, y);
    LineTo(ClientWidth - 5, y);
  end;

end;

procedure TColorArrayEditor.DrawSquare(X, Y: integer; AColor: TColor; IsFocused: boolean);
begin
  if ValidColorIndex(X, Y) then
  begin
    X := (X-1) * 18 + 10;
    Y := (Y-1) * 18 + 10;
  end else
    exit;

  with Canvas do
  begin
    if IsFocused then
      Pen.Color := clBlack
    else
      Pen.Color := clBtnFace;
    MoveTo(X-1,Y-1);
    LineTo(X+16, Y-1);
    LineTo(X+16, Y+16);
    LineTo(X-1, Y+16);
    LineTo(X-1, Y-1);

    if IsFocused then
    begin
      { Draw frame }
      MoveTo(X+1, Y+1);
      LineTo(X+14, Y+1);
      LineTo(X+14, Y+14);
      LineTo(X+1, Y+14);
      LineTo(X+1, Y+1);
      Pen.Color := clWhite;
      MoveTo(X, Y);
      LineTo(X+15, Y);
      LineTo(X+15, Y+15);
      LineTo(X, Y+15);
      LineTo(X, Y);
    end else begin
      Pen.Color := clGray;
      MoveTo(X, Y+15);
      LineTo(X, Y);
      LineTo(X+15, Y);
      Pen.Color := clWhite;
      LineTo(X+15, Y+15);
      LineTo(X, Y+15);
      Pen.Color := clBlack;
      MoveTo(X+1, Y+14);
      LineTo(X+1, Y+1);
      LineTo(X+14, Y+1);
      Pen.Color := RGB(223, 223, 223);
      LineTo(X+14, Y+14);
      LineTo(X+1, Y+14);
    end;

    Brush.Color := AColor;
    FillRect(Rect(X+2, Y+2, X+14, Y+14));
  end;
end;


procedure TColorArrayEditor.FrameCurrentSquare;

  function ComparePoints(const Pt1, Pt2: TPoint): boolean;
  begin
    Result := ((Pt1.X = Pt2.X) and (Pt1.Y =Pt2.Y));
  end;

var
  NewFrame: TPoint;
begin
  NewFrame := GetCurrentSquare;
  if not ComparePoints(NewFrame, FLastFrame) and
     ValidColorIndex(NewFrame.X, NewFrame.Y) then
  begin
    { Unframe the last one }
    if ValidColorIndex(FLastFrame.X, FLastFrame.Y) then
      with FLastFrame do
        DrawSquare(X, Y, FColors[X, Y], FALSE);
    with NewFrame do
      DrawSquare(X, Y, FColors[X, Y], TRUE);
    FLastFrame := NewFrame;
  end;
end;

function TColorArrayEditor.ValidColorIndex(X, Y: integer): boolean;
begin
  Result := ((X > 0) and (X <= Colors.XSize) and
     (Y > 0) and (Y <= Colors.YSize));
end;

function TColorArrayEditor.GetCurrentSquare: TPoint;
var
  CurPos: TPoint;
begin
  GetCursorPos(CurPos);
  CurPos := ScreenToClient(CurPos);
  Result := Point(((CurPos.X - 9) div 18) + 1, ((CurPos.Y - 9) div 18) + 1);
  if not ValidColorIndex(Result.X, Result.Y) then
    Result := Point(-1,-1);
end;

procedure TColorArrayEditor.FormCreate(Sender: TObject);
begin
  FLastFrame := Point(-1,-1);
end;

procedure TColorArrayEditor.FormMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  FrameCurrentSquare;
end;

procedure TColorArrayEditor.FormShow(Sender: TObject);
begin
  ClientWidth := Colors.XSize * 18 + 18;
  ClientHeight := Colors.YSize * 18 + 42;
  btnOK.Top := Colors.YSize * 18 + 19;
  btnOK.Left := (ClientWidth - btnOK.Width - btnCancel.Width - 5) div 2;
  btnCancel.Top := btnOK.Top;
  btnCancel.Left := btnOK.Left + btnOK.Width + 4;
end;

procedure TColorArrayEditor.FormClick(Sender: TObject);
var
  SelectedColorSquare: TPoint;
begin
  SelectedColorSquare := GetCurrentSquare;
  if ValidColorIndex(SelectedColorSquare.X, SelectedColorSquare.Y) then
  begin
    ColorDlg.Color := FColors[SelectedColorSquare.X, SelectedColorSquare.Y];
    if ColorDlg.Execute then
    begin
      with SelectedColorSquare do
      begin
        FColors[X, Y] := ColorDlg.Color;
        DrawSquare(X, Y, ColorDlg.Color, FALSE);
      end;
      FrameCurrentSquare;
    end;
  end;
end;

end.